home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / internet / srobj / srobj.frm < prev    next >
Text File  |  1995-12-22  |  59KB  |  1,926 lines
  1. VERSION 2.00
  2. Begin Form frmServerObject 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Save/Restore Server Object"
  6.    ClientHeight    =   5625
  7.    ClientLeft      =   2895
  8.    ClientTop       =   2730
  9.    ClientWidth     =   8055
  10.    Height          =   6030
  11.    Icon            =   SROBJ.FRX:0000
  12.    Left            =   2835
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   5625
  16.    ScaleWidth      =   8055
  17.    Top             =   2385
  18.    Width           =   8175
  19.    Begin Timer tmrDisplay 
  20.       Enabled         =   0   'False
  21.       Interval        =   1000
  22.       Left            =   60
  23.       Top             =   5820
  24.    End
  25.    Begin Frame zfraRestoreTo 
  26.       BackColor       =   &H00C0C0C0&
  27.       Caption         =   "Restore To AS/400 Library"
  28.       Height          =   915
  29.       Left            =   60
  30.       TabIndex        =   25
  31.       Top             =   4650
  32.       Width           =   4365
  33.       Begin CommandButton cmdRestore 
  34.          Caption         =   "&Restore"
  35.          FontBold        =   0   'False
  36.          FontItalic      =   0   'False
  37.          FontName        =   "MS Sans Serif"
  38.          FontSize        =   8.25
  39.          FontStrikethru  =   0   'False
  40.          FontUnderline   =   0   'False
  41.          Height          =   330
  42.          Left            =   2400
  43.          TabIndex        =   12
  44.          Top             =   480
  45.          Width           =   1785
  46.       End
  47.       Begin TextBox txtRestoreLibrary 
  48.          FontBold        =   0   'False
  49.          FontItalic      =   0   'False
  50.          FontName        =   "MS Sans Serif"
  51.          FontSize        =   8.25
  52.          FontStrikethru  =   0   'False
  53.          FontUnderline   =   0   'False
  54.          Height          =   285
  55.          Left            =   120
  56.          TabIndex        =   11
  57.          Top             =   480
  58.          Width           =   1935
  59.       End
  60.       Begin Label zlbl 
  61.          BackStyle       =   0  'Transparent
  62.          Caption         =   "Library"
  63.          FontBold        =   0   'False
  64.          FontItalic      =   0   'False
  65.          FontName        =   "MS Sans Serif"
  66.          FontSize        =   8.25
  67.          FontStrikethru  =   0   'False
  68.          FontUnderline   =   0   'False
  69.          Height          =   225
  70.          Index           =   9
  71.          Left            =   120
  72.          TabIndex        =   26
  73.          Top             =   240
  74.          Width           =   1365
  75.       End
  76.    End
  77.    Begin Frame zfraPCDataFile 
  78.       BackColor       =   &H00C0C0C0&
  79.       Caption         =   "PC Data File"
  80.       Height          =   915
  81.       Left            =   60
  82.       TabIndex        =   27
  83.       Top             =   3660
  84.       Width           =   7905
  85.       Begin TextBox txtPCFileName 
  86.          FontBold        =   0   'False
  87.          FontItalic      =   0   'False
  88.          FontName        =   "MS Sans Serif"
  89.          FontSize        =   8.25
  90.          FontStrikethru  =   0   'False
  91.          FontUnderline   =   0   'False
  92.          Height          =   285
  93.          Left            =   120
  94.          TabIndex        =   9
  95.          Top             =   480
  96.          Width           =   1695
  97.       End
  98.       Begin TextBox txtPCFileDirectory 
  99.          FontBold        =   0   'False
  100.          FontItalic      =   0   'False
  101.          FontName        =   "MS Sans Serif"
  102.          FontSize        =   8.25
  103.          FontStrikethru  =   0   'False
  104.          FontUnderline   =   0   'False
  105.          Height          =   285
  106.          Left            =   1860
  107.          TabIndex        =   10
  108.          Top             =   480
  109.          Width           =   5955
  110.       End
  111.       Begin Label zlbl 
  112.          BackStyle       =   0  'Transparent
  113.          Caption         =   "Name"
  114.          FontBold        =   0   'False
  115.          FontItalic      =   0   'False
  116.          FontName        =   "MS Sans Serif"
  117.          FontSize        =   8.25
  118.          FontStrikethru  =   0   'False
  119.          FontUnderline   =   0   'False
  120.          Height          =   225
  121.          Index           =   7
  122.          Left            =   120
  123.          TabIndex        =   28
  124.          Top             =   240
  125.          Width           =   1485
  126.       End
  127.       Begin Label zlbl 
  128.          BackStyle       =   0  'Transparent
  129.          Caption         =   "Directory"
  130.          FontBold        =   0   'False
  131.          FontItalic      =   0   'False
  132.          FontName        =   "MS Sans Serif"
  133.          FontSize        =   8.25
  134.          FontStrikethru  =   0   'False
  135.          FontUnderline   =   0   'False
  136.          Height          =   225
  137.          Index           =   8
  138.          Left            =   1860
  139.          TabIndex        =   32
  140.          Top             =   240
  141.          Width           =   1350
  142.       End
  143.    End
  144.    Begin Frame zFra400DataFile 
  145.       BackColor       =   &H00C0C0C0&
  146.       Caption         =   "AS/400 Data File"
  147.       Height          =   915
  148.       Left            =   60
  149.       TabIndex        =   35
  150.       Top             =   1320
  151.       Width           =   4395
  152.       Begin TextBox txtDataFileName 
  153.          FontBold        =   0   'False
  154.          FontItalic      =   0   'False
  155.          FontName        =   "MS Sans Serif"
  156.          FontSize        =   8.25
  157.          FontStrikethru  =   0   'False
  158.          FontUnderline   =   0   'False
  159.          Height          =   285
  160.          Left            =   120
  161.          TabIndex        =   20
  162.          Top             =   480
  163.          Width           =   1935
  164.       End
  165.       Begin TextBox txtDataFileLibrary 
  166.          FontBold        =   0   'False
  167.          FontItalic      =   0   'False
  168.          FontName        =   "MS Sans Serif"
  169.          FontSize        =   8.25
  170.          FontStrikethru  =   0   'False
  171.          FontUnderline   =   0   'False
  172.          Height          =   285
  173.          Left            =   2160
  174.          TabIndex        =   21
  175.          Top             =   480
  176.          Width           =   1935
  177.       End
  178.       Begin Label zlbl 
  179.          BackColor       =   &H00FFFFFF&
  180.          BackStyle       =   0  'Transparent
  181.          Caption         =   "Name"
  182.          FontBold        =   0   'False
  183.          FontItalic      =   0   'False
  184.          FontName        =   "MS Sans Serif"
  185.          FontSize        =   8.25
  186.          FontStrikethru  =   0   'False
  187.          FontUnderline   =   0   'False
  188.          Height          =   225
  189.          Index           =   5
  190.          Left            =   120
  191.          TabIndex        =   36
  192.          Top             =   240
  193.          Width           =   1485
  194.       End
  195.       Begin Label zlbl 
  196.          BackStyle       =   0  'Transparent
  197.          Caption         =   "Library"
  198.          FontBold        =   0   'False
  199.          FontItalic      =   0   'False
  200.          FontName        =   "MS Sans Serif"
  201.          FontSize        =   8.25
  202.          FontStrikethru  =   0   'False
  203.          FontUnderline   =   0   'False
  204.          Height          =   225
  205.          Index           =   6
  206.          Left            =   2160
  207.          TabIndex        =   37
  208.          Top             =   240
  209.          Width           =   1485
  210.       End
  211.    End
  212.    Begin Frame zfra400SaveFile 
  213.       BackColor       =   &H00C0C0C0&
  214.       Caption         =   "AS/400 Save File"
  215.       Height          =   915
  216.       Left            =   60
  217.       TabIndex        =   31
  218.       Top             =   360
  219.       Width           =   4395
  220.       Begin TextBox txtSaveFileName 
  221.          FontBold        =   0   'False
  222.          FontItalic      =   0   'False
  223.          FontName        =   "MS Sans Serif"
  224.          FontSize        =   8.25
  225.          FontStrikethru  =   0   'False
  226.          FontUnderline   =   0   'False
  227.          Height          =   285
  228.          Left            =   120
  229.          TabIndex        =   14
  230.          Top             =   480
  231.          Width           =   1935
  232.       End
  233.       Begin TextBox txtSaveFileLibrary 
  234.          FontBold        =   0   'False
  235.          FontItalic      =   0   'False
  236.          FontName        =   "MS Sans Serif"
  237.          FontSize        =   8.25
  238.          FontStrikethru  =   0   'False
  239.          FontUnderline   =   0   'False
  240.          Height          =   285
  241.          Left            =   2160
  242.          TabIndex        =   15
  243.          Top             =   480
  244.          Width           =   1935
  245.       End
  246.       Begin Label zlbl 
  247.          BackStyle       =   0  'Transparent
  248.          Caption         =   "Name"
  249.          FontBold        =   0   'False
  250.          FontItalic      =   0   'False
  251.          FontName        =   "MS Sans Serif"
  252.          FontSize        =   8.25
  253.          FontStrikethru  =   0   'False
  254.          FontUnderline   =   0   'False
  255.          Height          =   225
  256.          Index           =   3
  257.          Left            =   120
  258.          TabIndex        =   34
  259.          Top             =   240
  260.          Width           =   1485
  261.       End
  262.       Begin Label zlbl 
  263.          BackStyle       =   0  'Transparent
  264.          Caption         =   "Library"
  265.          FontBold        =   0   'False
  266.          FontItalic      =   0   'False
  267.          FontName        =   "MS Sans Serif"
  268.          FontSize        =   8.25
  269.          FontStrikethru  =   0   'False
  270.          FontUnderline   =   0   'False
  271.          Height          =   225
  272.          Index           =   4
  273.          Left            =   2160
  274.          TabIndex        =   33
  275.          Top             =   240
  276.          Width           =   1485
  277.       End
  278.    End
  279.    Begin Frame zfraSaveObject 
  280.       BackColor       =   &H00C0C0C0&
  281.       Caption         =   "Save Object"
  282.       Height          =   1335
  283.       Left            =   60
  284.       TabIndex        =   30
  285.       Top             =   2280
  286.       Width           =   7905
  287.       Begin ComboBox cboObjectRelease 
  288.          FontBold        =   0   'False
  289.          FontItalic      =   0   'False
  290.          FontName        =   "MS Sans Serif"
  291.          FontSize        =   8.25
  292.          FontStrikethru  =   0   'False
  293.          FontUnderline   =   0   'False
  294.          Height          =   315
  295.          Left            =   6390
  296.          TabIndex        =   4
  297.          Top             =   480
  298.          Width           =   1215
  299.       End
  300.       Begin CommandButton cmdCreate 
  301.          Caption         =   "&Create Save Set"
  302.          FontBold        =   0   'False
  303.          FontItalic      =   0   'False
  304.          FontName        =   "MS Sans Serif"
  305.          FontSize        =   8.25
  306.          FontStrikethru  =   0   'False
  307.          FontUnderline   =   0   'False
  308.          Height          =   330
  309.          Left            =   2370
  310.          TabIndex        =   6
  311.          Top             =   870
  312.          Width           =   1785
  313.       End
  314.       Begin CommandButton cmdSets 
  315.          Caption         =   "Selec&t Save Set"
  316.          FontBold        =   0   'False
  317.          FontItalic      =   0   'False
  318.          FontName        =   "MS Sans Serif"
  319.          FontSize        =   8.25
  320.          FontStrikethru  =   0   'False
  321.          FontUnderline   =   0   'False
  322.          Height          =   330
  323.          Left            =   120
  324.          TabIndex        =   5
  325.          Top             =   870
  326.          Width           =   1785
  327.       End
  328.       Begin CommandButton cmdSave 
  329.          Caption         =   "&Save"
  330.          FontBold        =   0   'False
  331.          FontItalic      =   0   'False
  332.          FontName        =   "MS Sans Serif"
  333.          FontSize        =   8.25
  334.          FontStrikethru  =   0   'False
  335.          FontUnderline   =   0   'False
  336.          Height          =   330
  337.          Left            =   4590
  338.          TabIndex        =   8
  339.          Top             =   870
  340.          Width           =   1785
  341.       End
  342.       Begin TextBox txtObjectName 
  343.          FontBold        =   0   'False
  344.          FontItalic      =   0   'False
  345.          FontName        =   "MS Sans Serif"
  346.          FontSize        =   8.25
  347.          FontStrikethru  =   0   'False
  348.          FontUnderline   =   0   'False
  349.          Height          =   285
  350.          Left            =   120
  351.          TabIndex        =   1
  352.          Top             =   480
  353.          Width           =   1935
  354.       End
  355.       Begin TextBox txtObjectLibrary 
  356.          FontBold        =   0   'False
  357.          FontItalic      =   0   'False
  358.          FontName        =   "MS Sans Serif"
  359.          FontSize        =   8.25
  360.          FontStrikethru  =   0   'False
  361.          FontUnderline   =   0   'False
  362.          Height          =   285
  363.          Left            =   2160
  364.          TabIndex        =   2
  365.          Top             =   480
  366.          Width           =   1935
  367.       End
  368.       Begin ComboBox cboObjectType 
  369.          FontBold        =   0   'False
  370.          FontItalic      =   0   'False
  371.          FontName        =   "MS Sans Serif"
  372.          FontSize        =   8.25
  373.          FontStrikethru  =   0   'False
  374.          FontUnderline   =   0   'False
  375.          Height          =   315
  376.          Left            =   4560
  377.          TabIndex        =   3
  378.          Top             =   480
  379.          Width           =   1215
  380.       End
  381.       Begin ComboBox cboSets 
  382.          FontBold        =   0   'False
  383.          FontItalic      =   0   'False
  384.          FontName        =   "MS Sans Serif"
  385.          FontSize        =   8.25
  386.          FontStrikethru  =   0   'False
  387.          FontUnderline   =   0   'False
  388.          Height          =   315
  389.          Left            =   120
  390.          Sorted          =   -1  'True
  391.          Style           =   2  'Dropdown List
  392.          TabIndex        =   0
  393.          Top             =   480
  394.          Visible         =   0   'False
  395.          Width           =   7695
  396.       End
  397.       Begin CommandButton cmdDelete 
  398.          Caption         =   "&Delete Save Set"
  399.          FontBold        =   0   'False
  400.          FontItalic      =   0   'False
  401.          FontName        =   "MS Sans Serif"
  402.          FontSize        =   8.25
  403.          FontStrikethru  =   0   'False
  404.          FontUnderline   =   0   'False
  405.          Height          =   330
  406.          Left            =   2370
  407.          TabIndex        =   7
  408.          Top             =   870
  409.          Visible         =   0   'False
  410.          Width           =   1785
  411.       End
  412.       Begin Label zlbl 
  413.          BackStyle       =   0  'Transparent
  414.          Caption         =   "Release"
  415.          FontBold        =   0   'False
  416.          FontItalic      =   0   'False
  417.          FontName        =   "MS Sans Serif"
  418.          FontSize        =   8.25
  419.          FontStrikethru  =   0   'False
  420.          FontUnderline   =   0   'False
  421.          Height          =   225
  422.          Index           =   14
  423.          Left            =   6390
  424.          TabIndex        =   45
  425.          Top             =   240
  426.          Width           =   855
  427.       End
  428.       Begin Label zlbl 
  429.          BackStyle       =   0  'Transparent
  430.          Caption         =   "Name"
  431.          FontBold        =   0   'False
  432.          FontItalic      =   0   'False
  433.          FontName        =   "MS Sans Serif"
  434.          FontSize        =   8.25
  435.          FontStrikethru  =   0   'False
  436.          FontUnderline   =   0   'False
  437.          Height          =   225
  438.          Index           =   0
  439.          Left            =   120
  440.          TabIndex        =   22
  441.          Top             =   240
  442.          Width           =   1485
  443.       End
  444.       Begin Label zlbl 
  445.          BackStyle       =   0  'Transparent
  446.          Caption         =   "Library"
  447.          FontBold        =   0   'False
  448.          FontItalic      =   0   'False
  449.          FontName        =   "MS Sans Serif"
  450.          FontSize        =   8.25
  451.          FontStrikethru  =   0   'False
  452.          FontUnderline   =   0   'False
  453.          Height          =   225
  454.          Index           =   1
  455.          Left            =   2160
  456.          TabIndex        =   23
  457.          Top             =   240
  458.          Width           =   1485
  459.       End
  460.       Begin Label zlbl 
  461.          BackStyle       =   0  'Transparent
  462.          Caption         =   "Type"
  463.          FontBold        =   0   'False
  464.          FontItalic      =   0   'False
  465.          FontName        =   "MS Sans Serif"
  466.          FontSize        =   8.25
  467.          FontStrikethru  =   0   'False
  468.          FontUnderline   =   0   'False
  469.          Height          =   225
  470.          Index           =   2
  471.          Left            =   4560
  472.          TabIndex        =   24
  473.          Top             =   240
  474.          Width           =   1485
  475.       End
  476.    End
  477.    Begin Frame zfraServerProgram 
  478.       BackColor       =   &H00C0C0C0&
  479.       Caption         =   "AS/400 Server Program"
  480.       Height          =   1875
  481.       Left            =   4530
  482.       TabIndex        =   29
  483.       Top             =   360
  484.       Width           =   3435
  485.       Begin ComboBox cboSystems 
  486.          FontBold        =   0   'False
  487.          FontItalic      =   0   'False
  488.          FontName        =   "MS Sans Serif"
  489.          FontSize        =   8.25
  490.          FontStrikethru  =   0   'False
  491.          FontUnderline   =   0   'False
  492.          Height          =   315
  493.          Left            =   90
  494.          Style           =   2  'Dropdown List
  495.          TabIndex        =   44
  496.          Top             =   450
  497.          Width           =   1905
  498.       End
  499.       Begin ComboBox cboPriority 
  500.          FontBold        =   0   'False
  501.          FontItalic      =   0   'False
  502.          FontName        =   "MS Sans Serif"
  503.          FontSize        =   8.25
  504.          FontStrikethru  =   0   'False
  505.          FontUnderline   =   0   'False
  506.          Height          =   315
  507.          Left            =   2340
  508.          Style           =   2  'Dropdown List
  509.          TabIndex        =   19
  510.          Top             =   1440
  511.          Width           =   795
  512.       End
  513.       Begin TextBox txtServerLibrary 
  514.          FontBold        =   0   'False
  515.          FontItalic      =   0   'False
  516.          FontName        =   "MS Sans Serif"
  517.          FontSize        =   8.25
  518.          FontStrikethru  =   0   'False
  519.          FontUnderline   =   0   'False
  520.          Height          =   285
  521.          Left            =   90
  522.          TabIndex        =   16
  523.          Top             =   1440
  524.          Width           =   1935
  525.       End
  526.       Begin OptionButton optServerMethod 
  527.          BackColor       =   &H00C0C0C0&
  528.          Caption         =   "REXX"
  529.          FontBold        =   0   'False
  530.          FontItalic      =   0   'False
  531.          FontName        =   "MS Sans Serif"
  532.          FontSize        =   8.25
  533.          FontStrikethru  =   0   'False
  534.          FontUnderline   =   0   'False
  535.          Height          =   225
  536.          Index           =   1
  537.          Left            =   2340
  538.          TabIndex        =   18
  539.          Top             =   720
  540.          Width           =   855
  541.       End
  542.       Begin OptionButton optServerMethod 
  543.          BackColor       =   &H00C0C0C0&
  544.          Caption         =   "RPG"
  545.          FontBold        =   0   'False
  546.          FontItalic      =   0   'False
  547.          FontName        =   "MS Sans Serif"
  548.          FontSize        =   8.25
  549.          FontStrikethru  =   0   'False
  550.          FontUnderline   =   0   'False
  551.          Height          =   225
  552.          Index           =   0
  553.          Left            =   2340
  554.          TabIndex        =   17
  555.          Top             =   480
  556.          Value           =   -1  'True
  557.          Width           =   735
  558.       End
  559.       Begin Label zlbl 
  560.          BackStyle       =   0  'Transparent
  561.          Caption         =   "Type"
  562.          FontBold        =   0   'False
  563.          FontItalic      =   0   'False
  564.          FontName        =   "MS Sans Serif"
  565.          FontSize        =   8.25
  566.          FontStrikethru  =   0   'False
  567.          FontUnderline   =   0   'False
  568.          Height          =   225
  569.          Index           =   13
  570.          Left            =   2310
  571.          TabIndex        =   43
  572.          Top             =   240
  573.          Width           =   615
  574.       End
  575.       Begin Label zlbl 
  576.          BackStyle       =   0  'Transparent
  577.          Caption         =   "System"
  578.          FontBold        =   0   'False
  579.          FontItalic      =   0   'False
  580.          FontName        =   "MS Sans Serif"
  581.          FontSize        =   8.25
  582.          FontStrikethru  =   0   'False
  583.          FontUnderline   =   0   'False
  584.          Height          =   225
  585.          Index           =   12
  586.          Left            =   90
  587.          TabIndex        =   42
  588.          Top             =   240
  589.          Width           =   615
  590.       End
  591.       Begin Label zlbl 
  592.          BackStyle       =   0  'Transparent
  593.          Caption         =   "Priority"
  594.          FontBold        =   0   'False
  595.          FontItalic      =   0   'False
  596.          FontName        =   "MS Sans Serif"
  597.          FontSize        =   8.25
  598.          FontStrikethru  =   0   'False
  599.          FontUnderline   =   0   'False
  600.          Height          =   225
  601.          Index           =   11
  602.          Left            =   2340
  603.          TabIndex        =   39
  604.          Top             =   1170
  605.          Width           =   615
  606.       End
  607.       Begin Label zlbl 
  608.          BackStyle       =   0  'Transparent
  609.          Caption         =   "Library"
  610.          FontBold        =   0   'False
  611.          FontItalic      =   0   'False
  612.          FontName        =   "MS Sans Serif"
  613.          FontSize        =   8.25
  614.          FontStrikethru  =   0   'False
  615.          FontUnderline   =   0   'False
  616.          Height          =   225
  617.          Index           =   10
  618.          Left            =   90
  619.          TabIndex        =   38
  620.          Top             =   1200
  621.          Width           =   915
  622.       End
  623.    End
  624.    Begin CommandButton cmdExit 
  625.       Caption         =   "E&xit"
  626.       FontBold        =   0   'False
  627.       FontItalic      =   0   'False
  628.       FontName        =   "MS Sans Serif"
  629.       FontSize        =   8.25
  630.       FontStrikethru  =   0   'False
  631.       FontUnderline   =   0   'False
  632.       Height          =   330
  633.       Left            =   6150
  634.       TabIndex        =   13
  635.       Top             =   5130
  636.       Width           =   1785
  637.    End
  638.    Begin Label lblStatus 
  639.       Alignment       =   2  'Center
  640.       BackColor       =   &H00000000&
  641.       ForeColor       =   &H0000FF00&
  642.       Height          =   255
  643.       Left            =   1320
  644.       TabIndex        =   41
  645.       Top             =   60
  646.       Width           =   6645
  647.    End
  648.    Begin Label lblTime 
  649.       Alignment       =   2  'Center
  650.       BackColor       =   &H00000000&
  651.       ForeColor       =   &H0000FF00&
  652.       Height          =   255
  653.       Left            =   60
  654.       TabIndex        =   40
  655.       Top             =   60
  656.       Width           =   1275
  657.    End
  658. End
  659. Option Explicit
  660.  
  661.  ' Constants:
  662.   Const bGet = True                     ' get default info
  663.   Const bSAVE = False                   ' save default info
  664.   Const nSAVEFILE_RECORD_SIZE = 528     ' record size in save file
  665.   Const sSERVER_RPG = "SROBJRPG"        ' RPG server
  666.   Const sSERVER_REX = "SROBJREX"        ' REXX server
  667.   Const sSOURCE_REX = "SRCREX"          ' REXX source file
  668.  
  669.  
  670.  ' Variables:
  671.   Dim bSaving        As Integer         ' running a save
  672.   Dim nRC            As Integer         ' return code
  673.   Dim sINIFile       As String          ' application INI file
  674.   Dim sCmd           As String          ' remote command to execute
  675.   Dim sMsgs          As String          ' remote command messages returned
  676.   Dim sPartnerSYS    As String          ' Partner system
  677.  
  678. Sub AppDefaults (bGet As Integer)
  679.  
  680.  ' Description:
  681.  '  Get or save defaults
  682.  
  683.  ' Parameters:
  684.  '  bGet           get defaults from file
  685.  
  686.  ' Constants:
  687.   Const sSECTION1 = "SERVER"
  688.   Const sSECTION2 = "OBJECT"
  689.   Const sSECTION3 = "SAVEFILE"
  690.   Const sSECTION4 = "DATAFILE"
  691.   Const sSECTION5 = "PCFILE"
  692.   Const sSECTION6 = "RESTORE"
  693.   Const sTOPIC1 = "Library"
  694.   Const sTOPIC2 = "Type"
  695.   Const sTOPIC3 = "Name"
  696.   Const sTOPIC4 = "Priority"
  697.   Const sTOPIC5 = "System"
  698.   Const sTOPIC6 = "Release"
  699.   Const sVALUE1 = "RPG"
  700.   Const sVALUE2 = "REXX"
  701.  
  702.  ' Variables:
  703.   Dim n1  As Integer
  704.   Dim nRC As Integer
  705.   Dim s1  As String
  706.  
  707.   MousePointer = HOURGLASS
  708.  
  709.   ' setup file reference
  710.   nRC = zzINISetFile(sINIFile)
  711.  
  712.   ' if getting defaults
  713.   If bGet Then
  714.  
  715.     ' setup first section
  716.     nRC = zzINISetSection(sSECTION1)
  717.     
  718.     ' put list of systems into control
  719.     Call zzCAPutSystemListIntoCtrl(Me.hWnd, cboSystems)
  720.     
  721.     ' get AS/400 server name
  722.     nRC = zzINIGetString(sTOPIC5, sPartnerSYS)
  723.     
  724.     ' see if match found
  725.     For n1 = 0 To cboSystems.ListCount - 1
  726.       If cboSystems.List(n1) = sPartnerSYS Then
  727.         cboSystems.ListIndex = n1
  728.         Exit For
  729.       End If
  730.     Next
  731.   
  732.     ' get server library
  733.     nRC = zzINIGetStringIntoTB(sTOPIC1, txtServerLibrary)
  734.     
  735.     ' get RPG/REXX option
  736.     nRC = zzINIGetString(sTOPIC2, s1)
  737.     optServerMethod(0).Value = (s1 = sVALUE1)
  738.     optServerMethod(1).Value = (s1 = sVALUE2)
  739.  
  740.     ' get job priority option
  741.     nRC = zzINIGetInteger(sTOPIC4, n1)
  742.     cboPriority.ListIndex = n1
  743.  
  744.     ' get object information
  745.     nRC = zzINISetSection(sSECTION2)
  746.     nRC = zzINIGetStringIntoTB(sTOPIC3, txtObjectName)
  747.     nRC = zzINIGetStringIntoTB(sTOPIC1, txtObjectLibrary)
  748.     nRC = zzINIGetStringIntoTB(sTOPIC2, cboObjectType)
  749.     nRC = zzINIGetStringIntoTB(sTOPIC6, cboObjectRelease)
  750.     
  751.     ' get save file information
  752.     nRC = zzINISetSection(sSECTION3)
  753.     nRC = zzINIGetStringIntoTB(sTOPIC3, txtSaveFileName)
  754.     nRC = zzINIGetStringIntoTB(sTOPIC1, txtSaveFileLibrary)
  755.  
  756.     ' get data file information
  757.     nRC = zzINISetSection(sSECTION4)
  758.     nRC = zzINIGetStringIntoTB(sTOPIC3, txtDataFileName)
  759.     nRC = zzINIGetStringIntoTB(sTOPIC1, txtDataFileLibrary)
  760.  
  761.     ' get PC file information
  762.     nRC = zzINISetSection(sSECTION5)
  763.     nRC = zzINIGetStringIntoTB(sTOPIC3, txtPCFileName)
  764.     nRC = zzINIGetStringIntoTB(sTOPIC1, txtPCFileDirectory)
  765.  
  766.     ' get restore library information
  767.     nRC = zzINISetSection(sSECTION6)
  768.     nRC = zzINIGetStringIntoTB(sTOPIC1, txtRestoreLibrary)
  769.  
  770.     ' get save sets
  771.     Call SaveSets(bGet)
  772.  
  773.   ' if saving defaults
  774.   Else
  775.   
  776.     ' save AS/400 server library, type, priority
  777.     nRC = zzINISetSection(sSECTION1)
  778.     nRC = zzINIPutString(sTOPIC5, sPartnerSYS)
  779.     nRC = zzINIPutString(sTOPIC1, txtServerLibrary.Text)
  780.     If optServerMethod(0) Then
  781.       nRC = zzINIPutString(sTOPIC2, sVALUE1)
  782.     Else
  783.       nRC = zzINIPutString(sTOPIC2, sVALUE2)
  784.     End If
  785.     nRC = zzINIPutInteger(sTOPIC4, cboPriority.ListIndex)
  786.  
  787.     ' save object information
  788.     nRC = zzINISetSection(sSECTION2)
  789.     nRC = zzINIPutString(sTOPIC3, txtObjectName.Text)
  790.     nRC = zzINIPutString(sTOPIC1, txtObjectLibrary.Text)
  791.     nRC = zzINIPutString(sTOPIC2, cboObjectType.Text)
  792.     nRC = zzINIPutString(sTOPIC6, cboObjectRelease.Text)
  793.   
  794.     ' save save file information
  795.     nRC = zzINISetSection(sSECTION3)
  796.     nRC = zzINIPutString(sTOPIC3, txtSaveFileName.Text)
  797.     nRC = zzINIPutString(sTOPIC1, txtSaveFileLibrary.Text)
  798.  
  799.     ' save data file information
  800.     nRC = zzINISetSection(sSECTION4)
  801.     nRC = zzINIPutString(sTOPIC3, txtDataFileName.Text)
  802.     nRC = zzINIPutString(sTOPIC1, txtDataFileLibrary.Text)
  803.  
  804.     ' save PC file information
  805.     nRC = zzINISetSection(sSECTION5)
  806.     nRC = zzINIPutString(sTOPIC3, txtPCFileName.Text)
  807.     nRC = zzINIPutString(sTOPIC1, txtPCFileDirectory.Text)
  808.  
  809.     ' save restore library information
  810.     nRC = zzINISetSection(sSECTION6)
  811.     nRC = zzINIPutString(sTOPIC1, txtRestoreLibrary.Text)
  812.  
  813.     ' save save sets
  814.     Call SaveSets(bGet)
  815.  
  816.   End If
  817.   
  818.   MousePointer = DEFAULT
  819.  
  820. End Sub
  821.  
  822. Sub cboObjectRelease_KeyPress (KeyASCII As Integer)
  823.  
  824.   ' gobble enter key and convert entry to uppercase
  825.   Call Gobble(cboObjectRelease, KeyASCII)
  826.  
  827. End Sub
  828.  
  829. Sub cboObjectType_KeyPress (KeyASCII As Integer)
  830.  
  831.   ' gobble enter key and convert entry to uppercase
  832.   Call Gobble(cboObjectType, KeyASCII)
  833.  
  834. End Sub
  835.  
  836. Sub cboSets_Click ()
  837.  
  838.  ' Variables:
  839.   Dim n2       As Integer
  840.   Dim s1       As String
  841.   Dim sDir     As String
  842.   Dim sFile    As String
  843.   Dim sLib     As String
  844.   Dim sName    As String
  845.   Dim sPath    As String
  846.   Dim sRelease As String
  847.   Dim sType    As String
  848.  
  849.   ' if form done loading
  850.   If tmrDisplay.Enabled Then
  851.     
  852.     ' if item selected
  853.     If cboSets.ListIndex >= 0 Then
  854.   
  855.       ' get currently selected item
  856.       s1 = cboSets.List(cboSets.ListIndex)
  857.   
  858.       ' find library/name seperator
  859.       n2 = InStr(s1, "/")
  860.       If n2 > 0 Then
  861.         
  862.         ' get library
  863.         sLib = Left$(s1, n2 - 1)
  864.         s1 = Mid$(s1, n2 + 1)
  865.       
  866.         ' get object name
  867.         n2 = InStr(s1, " ")
  868.         If n2 > 0 Then
  869.           sName = Left$(s1, n2 - 1)
  870.           s1 = Mid$(s1, n2 + 1)
  871.           
  872.           ' get object type
  873.           n2 = InStr(s1, " to ")
  874.           If n2 > 0 Then
  875.             sType = Left$(s1, n2 - 1)
  876.             
  877.             ' get directory and file
  878.             s1 = Mid$(s1, n2 + 4)
  879.             n2 = InStr(s1, " *")
  880.             If n2 = 0 Then n2 = InStr(s1, " V")
  881.  
  882.             If n2 > 0 Then
  883.               sPath = Left$(s1, n2 - 1)
  884.               sRelease = Mid$(s1, n2 + 1)
  885.             Else
  886.               sPath = s1
  887.               sRelease = "*CURRENT"
  888.             End If
  889.             
  890.             ' parse path name
  891.             Call zzFileParse(sPath, sDir, sFile)
  892.  
  893.           End If
  894.  
  895.         End If
  896.       
  897.       End If
  898.       
  899.     End If
  900.   
  901.     ' setup controls
  902.     If sName <> gsEMPTY Then txtObjectName = sName
  903.     If sLib <> gsEMPTY Then txtObjectLibrary = sLib
  904.     If sType <> gsEMPTY Then cboObjectType = sType
  905.     If sRelease <> gsEMPTY Then cboObjectRelease = sRelease
  906.     If sFile <> gsEMPTY Then txtPCFileName = sFile
  907.     If sDir <> gsEMPTY Then txtPCFileDirectory = sDir
  908.   
  909.   End If
  910.  
  911. End Sub
  912.  
  913. Sub cboSystems_Click ()
  914.  
  915.   ' place selected system in variable
  916.   sPartnerSYS = cboSystems.Text
  917.  
  918. End Sub
  919.  
  920. Sub cmdCreate_Click ()
  921.  
  922.  ' Description:
  923.  '  Creates a save set entry if one
  924.  '  does not already exist
  925.  
  926.  ' Variables:
  927.   Dim n1    As Integer
  928.   Dim s1    As String
  929.  
  930.   ' if maximum has not been reached
  931.   If cboSets.ListCount < 100 Then
  932.  
  933.     ' if valid values in controls
  934.     If txtObjectName.Text <> gsEMPTY Then
  935.       If txtObjectLibrary.Text <> gsEMPTY Then
  936.         If cboObjectType.Text <> gsEMPTY Then
  937.           If cboObjectRelease.Text <> gsEMPTY Then
  938.  
  939.             ' build string to add to combo box
  940.             s1 = UCase$(Trim$(txtObjectLibrary.Text) & "/" & Trim$(txtObjectName.Text) & " " & Trim$(cboObjectType.Text))
  941.             s1 = s1 & " to " & UCase$(zzPathFormat(Trim$(txtPCFileDirectory.Text)) & Trim$(txtPCFileName.Text))
  942.             s1 = s1 & " " & UCase$(cboObjectRelease.Text)
  943.             
  944.             ' see if already in combo box
  945.             ' if it is then no use to add it again
  946.             For n1 = 0 To cboSets.ListCount - 1
  947.               If s1 = cboSets.List(n1) Then
  948.                 If Not bSaving Then MsgBox "'" & s1 & "' already exists as save set.", MB_ICONSTOP
  949.                 Exit Sub
  950.               End If
  951.             Next n1
  952.       
  953.             ' add the new entry
  954.             cboSets.AddItem s1
  955.  
  956.           End If
  957.         End If
  958.       End If
  959.     End If
  960.   
  961.   End If
  962.  
  963. End Sub
  964.  
  965. Sub cmdDelete_Click ()
  966.  
  967.   ' remove current entry
  968.   If cboSets.ListIndex >= 0 Then
  969.     
  970.     ' setup message box
  971.     gsMBText = "Are you sure you wish to delete current entry '"
  972.     gsMBText = gsMBText & cboSets.List(cboSets.ListIndex) & "'?"
  973.     If MsgBox(gsMBText, MB_ICONQUESTION Or MB_YESNO) = IDYES Then
  974.       
  975.       ' remove entry
  976.       cboSets.RemoveItem cboSets.ListIndex
  977.       cboSets.Refresh
  978.       If cboSets.ListCount > 0 Then
  979.         cboSets.ListIndex = 0
  980.       Else
  981.         cboSets.ListIndex = -1
  982.       End If
  983.     
  984.       cmdDelete.Enabled = cboSets.ListCount > 0
  985.     
  986.     End If
  987.  
  988.   End If
  989.  
  990. End Sub
  991.  
  992. Sub cmdExit_Click ()
  993.  
  994.   Unload Me
  995.  
  996. End Sub
  997.  
  998. Sub cmdRestore_Click ()
  999.  
  1000.  ' Description:
  1001.  '  Restore object(s)
  1002.   
  1003.  ' Variables:
  1004.   Dim sLibrary          As String     ' original sav library
  1005.   Dim sObjectsRestored  As String     ' text showing number of objects restored
  1006.  
  1007.   ' please wait...
  1008.   Screen.MousePointer = HOURGLASS
  1009.   
  1010.   ' validate the data
  1011.   If DataValidation(False) <> True Then GoTo cmdRestoreExit
  1012.  
  1013.   ' get library name
  1014.   If GetSaveLibrary(sLibrary) <> True Then GoTo cmdRestoreExit
  1015.   
  1016.   ' set job priority, ignore messages that
  1017.   lblStatus = "Setting job priority"
  1018.   lblStatus.Refresh
  1019.   sCmd = "CHGJOB RUNPTY(" & cboPriority.Text & ")"
  1020.   If RunCmd(gsEMPTY, gsEMPTY) <> True Then GoTo cmdRestoreExit
  1021.  
  1022.   ' create the libary, ignore messages that
  1023.   ' library created (CPC2102) or library already exists (CPF2111)
  1024.   lblStatus = "Library " & txtRestoreLibrary & " being created"
  1025.   lblStatus.Refresh
  1026.   sCmd = "CRTLIB LIB(" & txtRestoreLibrary & ")"
  1027.   If RunCmd("CPC2102", "CPF2111") <> True Then GoTo cmdRestoreExit
  1028.  
  1029.   ' create the data file, ignore messages that
  1030.   ' file created (CPC7301) or already exists (CPF5813)
  1031.   lblStatus = "Data file " & txtDataFileLibrary & "/" & txtDataFileName & " being created"
  1032.   lblStatus.Refresh
  1033.   sCmd = "CRTPF FILE(" & txtDataFileLibrary & "/" & txtDataFileName & ") RCDLEN(528)"
  1034.   If RunCmd("CPC7301", "CPF5813") <> True Then GoTo cmdRestoreExit
  1035.  
  1036.   ' clear the data file, ignore messages that
  1037.   ' physical file cleared (CPC3101)
  1038.   lblStatus = "Data file " & txtDataFileLibrary & "/" & txtDataFileName & " being cleared"
  1039.   lblStatus.Refresh
  1040.   sCmd = "CLRPFM FILE(" & txtDataFileLibrary & "/" & txtDataFileName & ")"
  1041.   If RunCmd("CPC3101", gsEMPTY) <> True Then GoTo cmdRestoreExit
  1042.  
  1043.   ' transfer the file from the pc
  1044.   lblStatus = "PC file being copied to data file"
  1045.   lblStatus.Refresh
  1046.   If ObjectUpload() <> True Then GoTo cmdRestoreExit
  1047.  
  1048.   ' create save file, ignore messages that
  1049.   ' file created (CPC7301) or already exists (CPF5813)
  1050.   lblStatus = "Save file " & txtSaveFileLibrary & "/" & txtSaveFileName & " being created"
  1051.   lblStatus.Refresh
  1052.   sCmd = "CRTSAVF FILE(" & txtSaveFileLibrary & "/" & txtSaveFileName & ")"
  1053.   If RunCmd("CPC7301", "CPF5813") <> True Then GoTo cmdRestoreExit
  1054.  
  1055.   ' clear the savefile, ignore messages that file cleared
  1056.   lblStatus = "Save file " & txtSaveFileLibrary & "/" & txtSaveFileName & " being cleared"
  1057.   lblStatus.Refresh
  1058.   sCmd = "CLRSAVF FILE(" & txtSaveFileLibrary & "/" & txtSaveFileName & ")"
  1059.   If RunCmd("CPC3725", gsEMPTY) <> True Then GoTo cmdRestoreExit
  1060.  
  1061.   ' use RPG to copy data file to save file
  1062.   If optServerMethod(0) = True Then
  1063.     lblStatus = "Data file being copied to save file"
  1064.     lblStatus.Refresh
  1065.     sCmd = "CALL " & txtServerLibrary & "/" & sSERVER_RPG & " ('" & txtSaveFileName & "' '" & txtSaveFileLibrary & "' '" & txtDataFileName & "' '" & txtDataFileLibrary & "' 'TOSAVF')"
  1066.     If RunCmd(gsEMPTY, gsEMPTY) <> True Then GoTo cmdRestoreExit
  1067.   
  1068.   ' use REXX to copy data file to save file
  1069.   Else
  1070.     lblStatus = "Data file being copied to save file"
  1071.     lblStatus.Refresh
  1072.     sCmd = "STRREXPRC SRCMBR(" & sSERVER_REX & ") SRCFILE(" & txtServerLibrary & "/" & sSOURCE_REX & ") PARM('" & txtSaveFileLibrary & "/" & txtSaveFileName & " tosavf " & txtDataFileLibrary & "/" & txtDataFileName & "')"
  1073.     If RunCmd(gsEMPTY, gsEMPTY) <> True Then GoTo cmdRestoreExit
  1074.   End If
  1075.  
  1076.   ' restore the object, ignore messages that
  1077.   ' xxxx number of objects restored (CPC3703)
  1078.   lblStatus = "Object(s) being restored"
  1079.   lblStatus.Refresh
  1080.   sCmd = "RSTOBJ OBJ(" & txtObjectName & ") SAVLIB(" & sLibrary & ") DEV(*SAVF) OBJTYPE(" & cboObjectType.Text & ") SAVF(" & txtSaveFileLibrary & "/" & txtSaveFileName & ") RSTLIB(" & txtRestoreLibrary & ")"
  1081.   If RunCmd("CPC3703", gsEMPTY) <> True Then GoTo cmdRestoreExit
  1082.   
  1083.   ' see how many objects restored
  1084.   sObjectsRestored = Trim$(Mid$(sMsgs, InStr(sMsgs, ":") + 1))
  1085.   If Len(sObjectsRestored) > 3 Then sObjectsRestored = Left$(sObjectsRestored, Len(sObjectsRestored) - 3)
  1086.   lblStatus = sObjectsRestored
  1087.   lblStatus.Refresh
  1088.   
  1089. ' end of save sequence
  1090. cmdRestoreExit:
  1091.  
  1092.   ' end "orphaned" remote command job
  1093.   nRC = zzSREndConversation(Me.hWnd, cboSystems.Text)
  1094.   Screen.MousePointer = DEFAULT
  1095.  
  1096. End Sub
  1097.  
  1098. Sub cmdSave_Click ()
  1099.  
  1100.  ' Description:
  1101.  '  Save object(s)
  1102.                  
  1103.  ' Variables:
  1104.   Dim sObjsSaved  As String     ' text showing number of objects saved
  1105.  
  1106.   lblStatus = gsEMPTY
  1107.   Screen.MousePointer = HOURGLASS
  1108.  
  1109.   ' set saving flag
  1110.   bSaving = True
  1111.  
  1112.   ' save current object(s)
  1113.   ' as save set entry
  1114.   cmdCreate = True
  1115.  
  1116.   ' validate the data
  1117.   If DataValidation(True) <> True Then GoTo cmdSaveExit
  1118.  
  1119.   ' set job priority, ignore messages that
  1120.   lblStatus = "Setting job priority"
  1121.   lblStatus.Refresh
  1122.   sCmd = "CHGJOB RUNPTY(" & cboPriority.Text & ")"
  1123.   If RunCmd(gsEMPTY, gsEMPTY) <> True Then GoTo cmdSaveExit
  1124.  
  1125.   ' create save file, ignore messages that
  1126.   ' file created (CPC7301) or already exists (CPF5813)
  1127.   lblStatus = "Save file " & txtSaveFileLibrary & "/" & txtSaveFileName & " being created"
  1128.   lblStatus.Refresh
  1129.   sCmd = "CRTSAVF FILE(" & txtSaveFileLibrary & "/" & txtSaveFileName & ")"
  1130.   If RunCmd("CPC7301", "CPF5813") <> True Then GoTo cmdSaveExit
  1131.   
  1132.   ' clear the save file, ignore messages that
  1133.   ' save file cleared (CPC3725)
  1134.   lblStatus = "Save file " & txtSaveFileLibrary & "/" & txtSaveFileName & " being cleared"
  1135.   lblStatus.Refresh
  1136.   sCmd = "CLRSAVF FILE(" & txtSaveFileLibrary & "/" & txtSaveFileName & ")"
  1137.   If RunCmd("CPC3725", gsEMPTY) <> True Then GoTo cmdSaveExit
  1138.  
  1139.   ' create the data file, ignore messages that
  1140.   ' file created (CPC7301) or already exists (CPF5813)
  1141.   lblStatus = "Data file " & txtDataFileLibrary & "/" & txtDataFileName & " being created"
  1142.   lblStatus.Refresh
  1143.   sCmd = "CRTPF FILE(" & txtDataFileLibrary & "/" & txtDataFileName & ") RCDLEN(528)"
  1144.   If RunCmd("CPC7301", "CPF5813") <> True Then GoTo cmdSaveExit
  1145.  
  1146.   ' clear the data file, ignore messages that
  1147.   ' physical file cleared (CPC3101)
  1148.   lblStatus = "Data file " & txtDataFileLibrary & "/" & txtDataFileName & " being cleared"
  1149.   lblStatus.Refresh
  1150.   sCmd = "CLRPFM FILE(" & txtDataFileLibrary & "/" & txtDataFileName & ")"
  1151.   If RunCmd("CPC3101", gsEMPTY) <> True Then GoTo cmdSaveExit
  1152.  
  1153.   ' save the object(s), ignore messages that
  1154.   ' xxxx number of objects saved
  1155.   lblStatus = "Object(s) being saved to save file"
  1156.   lblStatus.Refresh
  1157.   sCmd = "SAVOBJ OBJ(" & txtObjectName & ") LIB(" & txtObjectLibrary & ") DEV(*SAVF) OBJTYPE(" & cboObjectType.Text & ") SAVF(" & txtSaveFileLibrary & "/" & txtSaveFileName & ") TGTRLS(" & cboObjectRelease.Text & ")"
  1158.   If RunCmd("CPC3722", "CPC3723") <> True Then GoTo cmdSaveExit
  1159.  
  1160.   ' see how many objects saved
  1161.   sObjsSaved = Trim$(Mid$(sMsgs, InStr(sMsgs, ":") + 1))
  1162.   If Len(sObjsSaved) > 3 Then sObjsSaved = Left$(sObjsSaved, Len(sObjsSaved) - 3)
  1163.   
  1164.   ' convert using RPG program
  1165.   If optServerMethod(0) Then
  1166.  
  1167.     lblStatus = "Save file being copied to data file"
  1168.     lblStatus.Refresh
  1169.     sCmd = "CALL " & txtServerLibrary & "/" & sSERVER_RPG & " ('" & txtSaveFileName & "' '" & txtSaveFileLibrary & "' '" & txtDataFileName & "' '" & txtDataFileLibrary & "' 'FROMSAVF')"
  1170.     If RunCmd(gsEMPTY, gsEMPTY) <> True Then GoTo cmdSaveExit
  1171.   
  1172.   ' convert using REXX program
  1173.   Else
  1174.     lblStatus = "Save file being copied to data file"
  1175.     lblStatus.Refresh
  1176.     sCmd = "STRREXPRC SRCMBR(" & sSERVER_REX & ") SRCFILE(" & txtServerLibrary & "/" & sSOURCE_REX & ") PARM('" & txtSaveFileLibrary & "/" & txtSaveFileName & " fromsavf " & txtDataFileLibrary & "/" & txtDataFileName & "')"
  1177.     If RunCmd(gsEMPTY, gsEMPTY) <> True Then GoTo cmdSaveExit
  1178.   End If
  1179.  
  1180.   ' transfer the file to the pc
  1181.   lblStatus = "Data file being copied to PC file"
  1182.   lblStatus.Refresh
  1183.   If ObjectDownload() <> True Then GoTo cmdSaveExit
  1184.  
  1185.   ' show how many objects saved
  1186.   lblStatus = sObjsSaved
  1187.   lblStatus.Refresh
  1188.   
  1189. ' end of save sequence
  1190. cmdSaveExit:
  1191.  
  1192.   ' end "orphaned" remote command job
  1193.   nRC = zzSREndConversation(Me.hWnd, cboSystems.Text)
  1194.   Screen.MousePointer = DEFAULT
  1195.  
  1196.   ' set saving flag off
  1197.   bSaving = False
  1198.  
  1199. End Sub
  1200.  
  1201. Sub cmdSets_Click ()
  1202.  
  1203.   ' if user wants to view save sets
  1204.   If cmdSets.Caption = "Selec&t Save Set" Then
  1205.  
  1206.     ' hide/show controls
  1207.     zlbl(1).Visible = False
  1208.     zlbl(2).Visible = False
  1209.     zlbl(14).Visible = False
  1210.     txtObjectName.Visible = False
  1211.     txtObjectLibrary.Visible = False
  1212.     cboObjectType.Visible = False
  1213.     cboObjectRelease.Visible = False
  1214.     cmdCreate.Visible = False
  1215.     cmdDelete.Visible = True
  1216.     cmdSave.Visible = False
  1217.     cboSets.Visible = True
  1218.     cmdDelete.Visible = True
  1219.     cmdDelete.Enabled = cboSets.ListCount > 0
  1220.     zfraPCDataFile.Visible = False
  1221.  
  1222.     ' set selection if none picked
  1223.     If cboSets.ListCount > 0 Then
  1224.       If cboSets.ListIndex = -1 Then
  1225.         cboSets.ListIndex = 0
  1226.       End If
  1227.     End If
  1228.     
  1229.     ' change captions
  1230.     zlbl(0).Caption = "Save Sets"
  1231.     cmdSets.Caption = "&Hide Save Sets"
  1232.     cboSets.SetFocus
  1233.  
  1234.   Else
  1235.     
  1236.     ' hide/show controls
  1237.     zlbl(0).Visible = True
  1238.     zlbl(1).Visible = True
  1239.     zlbl(2).Visible = True
  1240.     zlbl(14).Visible = True
  1241.     txtObjectName.Visible = True
  1242.     txtObjectLibrary.Visible = True
  1243.     cboObjectType.Visible = True
  1244.     cboObjectRelease.Visible = True
  1245.     cmdCreate.Visible = True
  1246.     cmdSave.Visible = True
  1247.     cboSets.Visible = False
  1248.     cmdDelete.Visible = False
  1249.     zfraPCDataFile.Visible = True
  1250.  
  1251.     ' change captions
  1252.     zlbl(0).Caption = "Name"
  1253.     cmdSets.Caption = "Selec&t Save Set"
  1254.     txtObjectName.SetFocus
  1255.  
  1256.   End If
  1257.  
  1258. End Sub
  1259.  
  1260. Function DataValidation (ByVal bSaving%) As Integer
  1261.  
  1262.  ' Description:
  1263.  '  Makes sure data is correct
  1264.  
  1265.  ' Parameters:
  1266.  '  bSaving              saving object flag
  1267.  
  1268.  ' Variables:
  1269.   Dim nFileNum           As Integer  ' file number
  1270.   Dim sMsg               As String   ' message text
  1271.   Dim sFile              As String   ' file name
  1272.  
  1273.   ' clear messages
  1274.   gsMBText = gsEMPTY
  1275.  
  1276.   ' test system selected
  1277.   If Len(cboSystems) = 0 Then
  1278.     gsMBText = gsMBText & gsCHR_CR & "Object system is blank. Please enter."
  1279.     cboSystems.SetFocus
  1280.   End If
  1281.  
  1282.   ' test object name
  1283.   If Len(Trim$(txtObjectName)) = 0 Then
  1284.     gsMBText = gsMBText & gsCHR_CR & "Object name is blank. Please enter."
  1285.     txtObjectName.SetFocus
  1286.   End If
  1287.  
  1288.   ' test object library
  1289.   If Len(Trim$(txtObjectLibrary)) = 0 Then
  1290.     gsMBText = gsMBText & gsCHR_CR & "Object library is blank. Please enter."
  1291.     txtObjectLibrary.SetFocus
  1292.   End If
  1293.  
  1294.   ' test object type
  1295.   If Len(Trim$(cboObjectType.Text)) = 0 Then
  1296.     gsMBText = gsMBText & gsCHR_CR & "Object type is blank. Please enter or select."
  1297.     cboObjectType.SetFocus
  1298.   End If
  1299.  
  1300.   ' test object release
  1301.   If Len(Trim$(cboObjectRelease.Text)) = 0 Then
  1302.     gsMBText = gsMBText & gsCHR_CR & "Object release level is blank. Please enter or select."
  1303.     cboObjectRelease.SetFocus
  1304.   End If
  1305.  
  1306.   ' test save file name
  1307.   If Len(Trim$(txtSaveFileName)) = 0 Then
  1308.     gsMBText = gsMBText & gsCHR_CR & "Save File name is blank. Please enter."
  1309.     txtSaveFileName.SetFocus
  1310.   End If
  1311.  
  1312.   ' test save File Library
  1313.   If Len(Trim$(txtSaveFileLibrary)) = 0 Then
  1314.     gsMBText = gsMBText & gsCHR_CR & "Save File library is blank. Please enter."
  1315.     txtSaveFileLibrary.SetFocus
  1316.   End If
  1317.   
  1318.   ' test data file name
  1319.   If Len(Trim$(txtDataFileName)) = 0 Then
  1320.     gsMBText = gsMBText & gsCHR_CR & "Data File name is blank. Please enter."
  1321.     txtDataFileName.SetFocus
  1322.   End If
  1323.  
  1324.   ' test data file Library
  1325.   If Len(Trim$(txtDataFileLibrary)) = 0 Then
  1326.     gsMBText = gsMBText & gsCHR_CR & "Data File library is blank. Please enter."
  1327.     txtDataFileLibrary.SetFocus
  1328.   End If
  1329.  
  1330.   ' test restore Library
  1331.   If Len(Trim$(txtRestoreLibrary)) = 0 Then
  1332.     gsMBText = gsMBText & gsCHR_CR & "Restore Library is blank. Please enter."
  1333.     txtRestoreLibrary.SetFocus
  1334.   End If
  1335.  
  1336.   ' test PC file name
  1337.   If Len(Trim$(txtPCFileName)) = 0 Then
  1338.     gsMBText = gsMBText & gsCHR_CR & "PC File name is blank. Please enter."
  1339.     txtPCFileName.SetFocus
  1340.   End If
  1341.  
  1342.   ' test PC Directory
  1343.   If Len(Trim$(txtPCFileDirectory)) = 0 Then
  1344.     gsMBText = gsMBText & gsCHR_CR & "PC File directory is blank. Please enter."
  1345.     txtPCFileDirectory.SetFocus
  1346.   End If
  1347.  
  1348.   ' if no error yet see if file name ok
  1349.   sFile = Trim$(txtPCFileDirectory)
  1350.   If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"
  1351.   sFile = sFile & Trim$(txtPCFileName)
  1352.  
  1353.   ' if PC file exists then
  1354.   If bSaving Then
  1355.     If zzFileExists(sFile) Then
  1356.       sMsg = UCase$(sFile) & " already exists and will be overwritten."
  1357.       sMsg = sMsg & " Do you wish to continue?"
  1358.       If MsgBox(sMsg, MB_ICONQUESTION Or MB_YESNO Or MB_DEFBUTTON2) = IDNO Then
  1359.         gsMBText = gsMBText & gsCHR_CR & "PC File name or directory must be changed to prevent overwrite. Please enter new name and/or directory."
  1360.         txtPCFileName.SetFocus
  1361.       End If
  1362.     End If
  1363.   End If
  1364.  
  1365.   ' handle errors
  1366.   On Error Resume Next
  1367.   Err = 0
  1368.   
  1369.   ' open the file
  1370.   nFileNum = FreeFile
  1371.   Open sFile For Binary As #nFileNum
  1372.   
  1373.   ' if any error then show text on message box
  1374.   If Err <> 0 Then gsMBText = gsMBText & gsCHR_CR & "PC File error: " & Error$
  1375.   
  1376.   ' close file
  1377.   Close #nFileNum
  1378.   On Error GoTo 0
  1379.  
  1380.   ' errors encountered
  1381.   If gsMBText <> gsEMPTY Then
  1382.     MsgBox gsMBText, MB_ICONSTOP
  1383.     DataValidation = False
  1384.   
  1385.   ' errors not found
  1386.   Else
  1387.     DataValidation = True
  1388.   End If
  1389.  
  1390. End Function
  1391.  
  1392. Sub Form_Load ()
  1393.  
  1394.  ' Variables:
  1395.   Dim n1 As Integer
  1396.  
  1397.   ' setup global variables
  1398.   Call zzSetGlobalVariables
  1399.  
  1400.   ' setup title and INI file
  1401.   App.Title = "Save/Restore Server Object"
  1402.   sINIFile = App.Path & "\srobj.ini"
  1403.   
  1404.   ' center form
  1405.   Call zzFormCenter(Me)
  1406.   
  1407.   ' setup object types combo
  1408.   Call ObjectTypes
  1409.  
  1410.   ' setup job priorities
  1411.   cboPriority.AddItem "10"
  1412.   cboPriority.AddItem "20"
  1413.   cboPriority.AddItem "30"
  1414.   cboPriority.AddItem "40"
  1415.   cboPriority.AddItem "50"
  1416.   cboPriority.AddItem "60"
  1417.  
  1418.   ' setup job priorities
  1419.   cboObjectRelease.AddItem "*CURRENT"
  1420.   cboObjectRelease.AddItem "*PRV"
  1421.   cboObjectRelease.AddItem "V2R3M0"
  1422.   cboObjectRelease.AddItem "V3R0M5"
  1423.   cboObjectRelease.AddItem "V3R1M0"
  1424.   cboObjectRelease.AddItem "V3R1M1"
  1425.   
  1426.   ' get program defaults
  1427.   Call AppDefaults(bGet)
  1428.   
  1429.   ' turn on timer
  1430.   tmrDisplay.Enabled = True
  1431.  
  1432. End Sub
  1433.  
  1434. Sub Form_Unload (Cancel As Integer)
  1435.  
  1436.   ' save current settings as defaults
  1437.   Call AppDefaults(bSAVE)
  1438.  
  1439.   ' end program
  1440.   End
  1441.  
  1442. End Sub
  1443.  
  1444. Function GetSaveLibrary (sLibrary$) As Integer
  1445.  
  1446.  ' Description:
  1447.  '  Returns the library that the object(s)
  1448.  '  was originally saved from. This is
  1449.  '  necessary for the RSTOBJ command.
  1450.  
  1451.  ' Parameters:
  1452.  '  sLibrary             library name returned
  1453.  
  1454.  ' Variables:
  1455.   Dim nFileNum           As Integer  ' file number
  1456.   Dim sFile              As String   ' file name
  1457.     
  1458.   ' open PC file to be uploaded
  1459.   sFile = Trim$(txtPCFileDirectory.Text)
  1460.   If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"
  1461.   sFile = sFile & Trim$(txtPCFileName.Text)
  1462.   nFileNum = FreeFile
  1463.   Open sFile For Binary As nFileNum
  1464.  
  1465.   ' fill with blanks
  1466.   sLibrary = Space$(12)
  1467.  
  1468.   ' get the string containing library name
  1469.   Get #nFileNum, 1315, sLibrary
  1470.  
  1471.   ' convert to ascii
  1472.   sLibrary = Trim$(zzCV_EBCDICToASCII(Me.hWnd, sLibrary))
  1473.  
  1474.   ' close the file
  1475.   Close nFileNum
  1476.  
  1477.   ' return true or false to caller
  1478.   GetSaveLibrary = sLibrary <> gsEMPTY
  1479.  
  1480. End Function
  1481.  
  1482. Sub Gobble (c As Control, KeyASCII As Integer)
  1483.   
  1484.   ' gobble up ENTER and make caps
  1485.   If KeyASCII = KEY_RETURN Then
  1486.     KeyASCII = 0
  1487.     SendKeys "{TAB}"
  1488.   Else
  1489.     KeyASCII = Asc(UCase$(Chr$(KeyASCII)))
  1490.   End If
  1491.  
  1492. End Sub
  1493.  
  1494. Function ObjectDownload () As Integer
  1495.  
  1496.  ' Description:
  1497.  '  Download data file which contains actual
  1498.  '  save file data to the local PC file
  1499.  
  1500.  ' Variables:
  1501.   Dim lConvID            As Long     ' conversation id
  1502.   Dim lProcCallBack      As Long     ' call back address
  1503.   Dim nAPIRC             As Integer  ' return code
  1504.   Dim nFileNum           As Integer  ' file number
  1505.   Dim nNumTemplates      As Integer  ' number of fields
  1506.   Dim sBuffer            As String   ' transfer buffer
  1507.   Dim sDataReturned      As String   ' data returned
  1508.   Dim sFile              As String   ' file name
  1509.  
  1510.   ' execute SELECT
  1511.   sBuffer = "SELECT * FROM " & Trim$(txtDataFileLibrary.Text) & "/" & Trim$(txtDataFileName.Text)
  1512.   nAPIRC = zzTFOpen(Me.hWnd, lProcCallBack, lConvID, sBuffer, cboSystems.Text, nNumTemplates)
  1513.   
  1514.   ' if select worked
  1515.   If nAPIRC = gnTF_OK Then
  1516.  
  1517.     ' setup the PC file name
  1518.     sFile = Trim$(txtPCFileDirectory)
  1519.     If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"
  1520.     sFile = sFile & Trim$(txtPCFileName)
  1521.  
  1522.     ' delete and open PC file
  1523.     On Error Resume Next
  1524.     Kill sFile
  1525.     nFileNum = FreeFile
  1526.     Open sFile For Binary As #nFileNum
  1527.  
  1528.     ' retrieve records
  1529.     Do
  1530.       DoEvents
  1531.       nAPIRC = zzTFGetRecord(Me.hWnd, lProcCallBack, lConvID, cboSystems.Text, gnTF_NO_CONVERSION, sDataReturned)
  1532.       If nAPIRC <> gnTF_OK Then Exit Do
  1533.       Put #nFileNum, , sDataReturned
  1534.     Loop
  1535.  
  1536.     ' close file and conversation
  1537.     Close #nFileNum
  1538.     ObjectDownload = True
  1539.   
  1540.   Else
  1541.     MsgBox "File transfer download error 'x'" & Hex$(nAPIRC) & " encountered.", MB_ICONSTOP
  1542.     ObjectDownload = False
  1543.   End If
  1544.  
  1545.   ' close active transfer requests
  1546.   nAPIRC = zzTFEndConversation(Me.hWnd, lProcCallBack, lConvID, cboSystems.Text)
  1547.  
  1548. End Function
  1549.  
  1550. Sub ObjectTypes ()
  1551.  
  1552.  ' Description
  1553.  '  Loads the object type Combo with valid AS400 object types.
  1554.  
  1555.  ' Variables:
  1556.   Dim c As Control
  1557.  
  1558.   ' use a abbreviated name as a pointer to the cboObjectType Object
  1559.   Set c = cboObjectType
  1560.  
  1561.   ' clear the combo box contents
  1562.   c.Clear
  1563.  
  1564.   ' add the combo box items
  1565.   c.AddItem "*ALL"
  1566.   c.AddItem "*ALRTBL"
  1567.   c.AddItem "*AUTL"
  1568.   c.AddItem "*BNDDIR"
  1569.   c.AddItem "*CFGL"
  1570.   c.AddItem "*CHTFMT"
  1571.   c.AddItem "*CLD"
  1572.   c.AddItem "*CLS"
  1573.   c.AddItem "*CMD"
  1574.   c.AddItem "*CNNL"
  1575.   c.AddItem "*COSD"
  1576.   c.AddItem "*CSI"
  1577.   c.AddItem "*CSPMAP"
  1578.   c.AddItem "*CSPTBL"
  1579.   c.AddItem "*CTLD"
  1580.   c.AddItem "*DEVD"
  1581.   c.AddItem "*DOC"
  1582.   c.AddItem "*DTAARA"
  1583.   c.AddItem "*DTADCT"
  1584.   c.AddItem "*DTAQ"
  1585.   c.AddItem "*EDTD"
  1586.   c.AddItem "*FCT"
  1587.   c.AddItem "*FILE"
  1588.   c.AddItem "*FLR"
  1589.   c.AddItem "*FNTRSC"
  1590.   c.AddItem "*FORMDF"
  1591.   c.AddItem "*FTR"
  1592.   c.AddItem "*GSS"
  1593.   c.AddItem "*JOBD"
  1594.   c.AddItem "*JOBQ"
  1595.   c.AddItem "*JOBSCD"
  1596.   c.AddItem "*JRN"
  1597.   c.AddItem "*JRNRCV"
  1598.   c.AddItem "*LIB"
  1599.   c.AddItem "*LIND"
  1600.   c.AddItem "*MENU"
  1601.   c.AddItem "*MODD"
  1602.   c.AddItem "*MODULE"
  1603.   c.AddItem "*MSGF"
  1604.   c.AddItem "*MSGQ"
  1605.   c.AddItem "*NODL"
  1606.   c.AddItem "*NWID"
  1607.   c.AddItem "*OUTQ"
  1608.   c.AddItem "*OVL"
  1609.   c.AddItem "*PAGDFN"
  1610.   c.AddItem "*PAGSEG"
  1611.   c.AddItem "*PDG"
  1612.   c.AddItem "*PGM"
  1613.   c.AddItem "*PNLGRP"
  1614.   c.AddItem "*PRDVAL"
  1615.   c.AddItem "*PRDDFN"
  1616.   c.AddItem "*PRDLOD"
  1617.   c.AddItem "*QMFORM"
  1618.   c.AddItem "*QMQRY"
  1619.   c.AddItem "*QRYDFN"
  1620.   c.AddItem "*RCT"
  1621.   c.AddItem "*SBSD"
  1622.   c.AddItem "*SCHIDX"
  1623.   c.AddItem "*SPADCT"
  1624.   c.AddItem "*SQLPKG"
  1625.   c.AddItem "*SRVPGM"
  1626.   c.AddItem "*SSND"
  1627.   c.AddItem "*S36"
  1628.   c.AddItem "*TBL"
  1629.   c.AddItem "*USRIDX"
  1630.   c.AddItem "*USRPRF"
  1631.   c.AddItem "*USRQ"
  1632.   c.AddItem "*USRSPC"
  1633.   c.AddItem "*WSCCST"
  1634.  
  1635. End Sub
  1636.  
  1637. Function ObjectUpload () As Integer
  1638.  
  1639.  ' Description:
  1640.  '  Upload PC file which contains save file
  1641.  '  data to the AS/400 data file which will
  1642.  '  be copied to the save file.
  1643.  
  1644.  ' Variables:
  1645.   Dim lConvID            As Long     ' conversation id
  1646.   Dim lProcCallBack      As Long     ' call back address
  1647.   Dim lI                 As Long     ' working index
  1648.   Dim lLOF               As Long     ' length of file
  1649.   Dim lRecords           As Long     ' number of records to process
  1650.   Dim nAPIRC             As Integer  ' return code
  1651.   Dim nFileNum           As Integer  ' file number
  1652.   Dim nNumTemplates      As Integer  ' number of fields
  1653.   Dim sBuffer            As String   ' transfer buffer
  1654.   Dim sFile              As String   ' file name
  1655.   Dim sRecord            As String   ' data returned
  1656.  
  1657.   ' execute REPLACE
  1658.   sBuffer = "REPLACE * INTO " + Trim$(txtDataFileLibrary.Text) & "/" & Trim$(txtDataFileName.Text)
  1659.   nAPIRC = zzTFOpen(Me.hWnd, lProcCallBack, lConvID, sBuffer, cboSystems.Text, nNumTemplates)
  1660.  
  1661.   ' no transfer error
  1662.   If nAPIRC = gnTF_OK Then
  1663.     
  1664.     ' open PC file to be uploaded
  1665.     sFile = Trim$(txtPCFileDirectory.Text)
  1666.     If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"
  1667.     sFile = sFile & Trim$(txtPCFileName.Text)
  1668.     nFileNum = FreeFile
  1669.     Open sFile For Binary As nFileNum
  1670.     
  1671.     ' get count of records
  1672.     lLOF = LOF(nFileNum)
  1673.     lRecords = lLOF / nSAVEFILE_RECORD_SIZE
  1674.  
  1675.     ' write each record to AS/400
  1676.     For lI = 1 To lRecords
  1677.       sRecord = Space$(nSAVEFILE_RECORD_SIZE)
  1678.       Get #nFileNum, , sRecord
  1679.       DoEvents
  1680.       nAPIRC = zzTFSendRecord(Me.hWnd, lProcCallBack, lConvID, cboSystems.Text, gnTF_NO_CONVERSION, sRecord, nSAVEFILE_RECORD_SIZE)
  1681.       If nAPIRC = gnTF_XFER_REQ_NOT_OPENED Then Exit For
  1682.       If nAPIRC = gnTF_EOF Then Exit For
  1683.     Next lI
  1684.  
  1685.     ' close the output file
  1686.     Close nFileNum
  1687.     ObjectUpload = True
  1688.   
  1689.   ' error
  1690.   Else
  1691.     MsgBox "File transfer upload error 'x'" & Hex$(nAPIRC) & " encountered.", MB_ICONSTOP
  1692.     ObjectUpload = False
  1693.   End If
  1694.  
  1695.   ' close file
  1696.   nAPIRC = zzTFClose(Me.hWnd, lProcCallBack, lConvID, cboSystems.Text)
  1697.  
  1698.   ' close active transfer requests
  1699.   nAPIRC = zzTFEndConversation(Me.hWnd, lProcCallBack, lConvID, cboSystems.Text)
  1700.  
  1701. End Function
  1702.  
  1703. Sub optServerMethod_KeyPress (Index As Integer, KeyASCII As Integer)
  1704.   
  1705.   ' gobble enter key and convert entry to uppercase
  1706.   Call Gobble(optServerMethod(Index), KeyASCII)
  1707.  
  1708. End Sub
  1709.  
  1710. Function RunCmd (ByVal sIgnoreMsg1$, ByVal sIgnoreMsg2$) As Integer
  1711.  
  1712.  ' Description:
  1713.  '  Execute command passed
  1714.  
  1715.  ' Parameters:
  1716.  '  sIgnoreMsg1         1st message to ignore
  1717.  '  sIgnoreMsg2         2nd message to ignore
  1718.  
  1719.  ' Variables:
  1720.   Dim lProcCallBack     As Long     ' call back address
  1721.   Dim nAPIRC            As Integer  ' API return code
  1722.   Dim nZ                As Integer  ' work index
  1723.  
  1724.   ' assume command worked
  1725.   RunCmd = True
  1726.  
  1727.   ' submit command
  1728.   nAPIRC = zzSRCmdAndFormatMsgsWithCB(Me.hWnd, cboSystems.Text, sCmd, sMsgs, lProcCallBack)
  1729.   
  1730.   ' if no severe error
  1731.   If nAPIRC <= gnSR_ERROR Then
  1732.   
  1733.     ' if messages returned
  1734.     If Len(sMsgs) > 0 Then
  1735.  
  1736.       ' don't ignore 1st message
  1737.       If sIgnoreMsg1 = gsEMPTY Then
  1738.  
  1739.         ' show messages
  1740.         MsgBox sMsgs, MB_ICONSTOP
  1741.         RunCmd = False
  1742.  
  1743.       ' ignore 1st message
  1744.       Else
  1745.         
  1746.         ' if 1st message not found
  1747.         nZ = InStr(1, sMsgs, sIgnoreMsg1)
  1748.         If nZ = 0 Then
  1749.  
  1750.           ' don't ignore 2nd message
  1751.           If sIgnoreMsg2 = gsEMPTY Then
  1752.             MsgBox sMsgs, MB_ICONSTOP
  1753.             RunCmd = False
  1754.  
  1755.           ' if 2nd message not found then
  1756.           ' show messages that were returned
  1757.           Else
  1758.  
  1759.             If InStr(1, sMsgs, sIgnoreMsg2) = 0 Then
  1760.               MsgBox sMsgs, MB_ICONSTOP
  1761.               RunCmd = False
  1762.             End If
  1763.           
  1764.           End If
  1765.  
  1766.         End If
  1767.  
  1768.       End If
  1769.  
  1770.     End If
  1771.   
  1772.   ' if severe error show it
  1773.   ' command did not work
  1774.   Else
  1775.     MsgBox "Remote command error 'x'" & Hex$(nAPIRC) & " encountered.", MB_ICONSTOP
  1776.     RunCmd = False
  1777.   End If
  1778.  
  1779.   ' give up timeslice
  1780.   DoEvents
  1781.   
  1782. End Function
  1783.  
  1784. Sub SaveSets (ByVal bGet%)
  1785.  
  1786.  
  1787.  ' Description:
  1788.  '  Get or save save sets
  1789.  
  1790.  ' Parameters:
  1791.  '  bGet           get defaults from file
  1792.  
  1793.  ' Constants:
  1794.   Const sSECTION6 = "SAVESETS"
  1795.   
  1796.  ' Variables:
  1797.   Dim n1  As Integer
  1798.   Dim s1  As String
  1799.  
  1800.   ' if getting defaults
  1801.   If bGet Then
  1802.  
  1803.     ' setup save sets section
  1804.     nRC = zzINISetSection(sSECTION6)
  1805.     
  1806.     ' clear any existing entries
  1807.     cboSets.Clear
  1808.     
  1809.     ' up to 100 entries possible
  1810.     For n1 = 0 To 99
  1811.  
  1812.       ' get next entry
  1813.       nRC = zzINIGetString(Right$("0" & Format$(n1), 2), s1)
  1814.  
  1815.       ' if something returned add to combo box
  1816.       If s1 <> gsEMPTY Then cboSets.AddItem s1
  1817.       
  1818.     Next n1
  1819.  
  1820.     ' move to first entry
  1821.     If cboSets.ListCount > 0 Then
  1822.       cboSets.ListIndex = 0
  1823.     End If
  1824.  
  1825.   ' if saving sets
  1826.   Else
  1827.  
  1828.     ' delete all entries in existing section
  1829.     nRC = zzINIDelSection(sSECTION6)
  1830.     
  1831.     ' setup save sets section
  1832.     nRC = zzINISetSection(sSECTION6)
  1833.  
  1834.     ' up to 99 entries possible
  1835.     For n1 = 0 To cboSets.ListCount - 1
  1836.  
  1837.       ' get entry from combo box
  1838.       s1 = cboSets.List(n1)
  1839.  
  1840.       ' put next entry into INI file
  1841.       nRC = zzINIPutString(Right$("0" & Format$(n1), 2), s1)
  1842.  
  1843.     Next n1
  1844.     
  1845.   End If
  1846.  
  1847. End Sub
  1848.  
  1849. Sub tmrDisplay_Timer ()
  1850.  
  1851.   ' show time
  1852.   lblTime = Format$(Time$, "h:mm:ss AM/PM")
  1853.  
  1854. End Sub
  1855.  
  1856. Sub txtDataFileLibrary_KeyPress (KeyASCII As Integer)
  1857.  
  1858.   ' gobble enter key and convert entry to uppercase
  1859.   Call Gobble(txtDataFileLibrary, KeyASCII)
  1860.  
  1861. End Sub
  1862.  
  1863. Sub txtDataFileName_KeyPress (KeyASCII As Integer)
  1864.  
  1865.   ' gobble enter key and convert entry to uppercase
  1866.   Call Gobble(txtDataFileName, KeyASCII)
  1867.  
  1868. End Sub
  1869.  
  1870. Sub txtObjectLibrary_KeyPress (KeyASCII As Integer)
  1871.  
  1872.   ' gobble enter key and convert entry to uppercase
  1873.   Call Gobble(txtObjectLibrary, KeyASCII)
  1874.  
  1875. End Sub
  1876.  
  1877. Sub txtObjectName_KeyPress (KeyASCII As Integer)
  1878.  
  1879.   ' gobble enter key and convert entry to uppercase
  1880.   Call Gobble(txtObjectName, KeyASCII)
  1881.  
  1882. End Sub
  1883.  
  1884. Sub txtPCFileDirectory_KeyPress (KeyASCII As Integer)
  1885.  
  1886.   ' gobble enter key and convert entry to uppercase
  1887.   Call Gobble(txtPCFileDirectory, KeyASCII)
  1888.  
  1889. End Sub
  1890.  
  1891. Sub txtPCFileName_KeyPress (KeyASCII As Integer)
  1892.  
  1893.   ' gobble enter key and convert entry to uppercase
  1894.   Call Gobble(txtPCFileName, KeyASCII)
  1895.  
  1896. End Sub
  1897.  
  1898. Sub txtRestoreLibrary_KeyPress (KeyASCII As Integer)
  1899.  
  1900.   ' gobble enter key and convert entry to uppercase
  1901.   Call Gobble(txtRestoreLibrary, KeyASCII)
  1902.  
  1903. End Sub
  1904.  
  1905. Sub txtSaveFileLibrary_KeyPress (KeyASCII As Integer)
  1906.  
  1907.   ' gobble enter key and convert entry to uppercase
  1908.   Call Gobble(txtSaveFileLibrary, KeyASCII)
  1909.  
  1910. End Sub
  1911.  
  1912. Sub txtSaveFileName_KeyPress (KeyASCII As Integer)
  1913.  
  1914.   ' gobble enter key and convert entry to uppercase
  1915.   Call Gobble(txtSaveFileName, KeyASCII)
  1916.  
  1917. End Sub
  1918.  
  1919. Sub txtServerLibrary_KeyPress (KeyASCII As Integer)
  1920.   
  1921.   ' gobble enter key and convert entry to uppercase
  1922.   Call Gobble(txtServerLibrary, KeyASCII)
  1923.  
  1924. End Sub
  1925.  
  1926.